home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / 3D_HOLE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  2.3 KB  |  70 lines
  1.  
  2. program mode_13h_3d; { 3D_HOLE.PAS }
  3. { mode-13h version of polygoned object - inc. backgroud, by Bas van Gaalen }
  4. uses u_vga,u_ffpcx,u_pal,u_3d,u_kb;
  5. const
  6.   fpoly=1; { first poly to draw from }
  7.   nofpoints=12; { number of points }
  8.   nofplanes=8; { number of planes }
  9.   points:array[1..nofpoints,0..2] of integer=(
  10.     (-20,-20, 30),( 20,-20, 30),( 40,-40,  0),( 20,-20,-30),
  11.     (-20,-20,-30),(-40,-40,  0),(-20, 20, 30),( 20, 20, 30),
  12.     ( 40, 40,  0),( 20, 20,-30),(-20, 20,-30),(-40, 40,  0));
  13.   planes:array[1..nofplanes,0..3] of byte=(
  14.     (2,3,9,8),(10,9,3,4),(11,5,6,12),(7,12,6,1),
  15.     (1,2,3,6),(6,3,4,5),(7,8,9,12),(12,9,10,11));
  16. var page,virscr:pointer;
  17.  
  18. procedure rotate_object;
  19. const xst=2; yst=2; zst=-1;
  20. var
  21.   xp,yp,z:array[1..nofpoints] of integer;
  22.   x,y:integer;
  23.   n,phix,phiy,phiz:byte;
  24. begin
  25.   {u_border:=true;}
  26.   phix:=0; phiy:=0; phiz:=0;
  27.   fillchar(xp,sizeof(xp),0);
  28.   fillchar(yp,sizeof(yp),0);
  29.   fillchar(z,sizeof(z),0);
  30.   destenation:=virscr;
  31.   repeat
  32.     vretrace;
  33.     setborder(200);
  34.     flip(page,virscr,320*200);
  35.     for n:=1 to nofpoints do begin
  36.       x:=points[n,0]; y:=points[n,1]; z[n]:=points[n,2];
  37.       rotate(x,y,z[n],phix,phiy,phiz);
  38.       conv3dto2d(xp[n],yp[n],x,y,z[n]);
  39.       inc(xp[n],160); inc(yp[n],100);
  40.     end;
  41.     for n:=1 to nofplanes do begin
  42.       polyz[n]:=(z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]) div 4;
  43.       pind[n]:=n;
  44.     end;
  45.     quicksort(nofplanes);
  46.     for n:=fpoly to nofplanes do
  47.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  48.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  49.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  50.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],
  51.               ctab[phix] div 2,0,pind[n]);
  52.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst);
  53.     setborder(0);
  54.     flip(virscr,vidptr,320*200);
  55.   until keypressed;
  56. end;
  57.  
  58. var pcxpal:pal_type; pcxpic:pointer; i:byte;
  59. begin
  60.   getmem(page,320*200); getmem(virscr,320*200);
  61.   if pcx_load('bots.pcx',page,pcxpal)<>pcx_ok then begin
  62.     writeln('An error ocured: ',pcx_errstr); halt; end;
  63.   setvideo($13);
  64.   setpal(pcxpal);
  65.   for i:=1 to nofplanes do setrgb(i,10+i,10+i,15+i*2);
  66.   rotate_object;
  67.   freemem(page,320*200); freemem(virscr,320*200);
  68.   setvideo(u_lm);
  69. end.
  70.